home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d949.lha
/
BBBBS
/
BBBBS65.lha
/
rexx
/
ArcAlpha.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-07-30
|
7KB
|
285 lines
/* $VER: ArcAlpha.rexx 6.2 © 1993 Richard Lee Stockton (30.7.93)
archives user defined alphafilelist into file in users email
receives its arguments from rexxDoors/Make_BrowseList.rexx
copyright 1991-93 Richard Lee Stockton FREELY DISTRIBUTABLE
*/
CALL TIME('R')
SIGNAL ON ERROR
SIGNAL ON SYNTAX
OPTIONS FAILAT 999999
PARSE ARG name lastbrowse alphaflag libflag numlist
lastbrowse=STRIP(lastbrowse)
CALL CLOSE(STDOUT)
CALL OPEN(STDOUT,'RAM:ArcAlpha.STDOUT','W')
SAY STRIP(SUBSTR(SOURCELINE(1),3))
SAY
IF ~DATATYPE(lastbrowse,'N') | name='' | numlist='' THEN
CALL GETOUT(20)
figarg='s:CONFIG.BBS'
IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
x=OPEN(f,figarg,'R')
IF x=0 THEN
DO
SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
CALL GETOUT(21)
END
lynes.=''
DO i=1 TO 33
lynes.i=READLN(f)
END
CALL CLOSE(f)
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname = STRIP(lynes.1)
sysop = WORD(lynes.2,1)
bbspath = WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
DO
SAY bbspath 'does not exist!'
CALL SETCLIP('BBS_ALPHA')
CALL GETOUT(22)
END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
DO i=1
IF GETCLIP('BBS_ALPHA'i)='' THEN /* info clip for external STOP */
DO
CALL SETCLIP('BBS_ALPHA'i,name)
clipnum=i
LEAVE i
END
END
CALL PRAGMA('P',-3) /* lower the priority of this task */
extension=WORD(lynes.32,1)
arccom=lynes.33
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
DO
extension='.lzh'
arccom='lharc -m m'
END
filepath=bbspath'EmailFiles/'name
CALL MAKEDIR(filepath)
x=OPEN(f,bbspath'Numbers/LastMail','R')
IF x~=0 THEN lastm=READLN(f)+1
CALL CLOSE(f)
ADDRESS COMMAND 'ECHO >'bbspath'Numbers/LastMail 'lastm
alphaname=filepath'/BBBBS_'lastm
filelist.=''
filelist.0=0
IF alphaflag='D' THEN
DO
x=OPEN(f,bbspath'Lists/Files','R')
IF x=0 THEN CALL GETOUT(24)
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
num=WORD(line,1)
IF ~DATATYPE(num,'W') THEN ITERATE i
filelist.num=WORD(line,3)
IF num>filelist.0 THEN filelist.0=num
END
CALL CLOSE(f)
END
alphalist.=''
x=OPEN(f,bbspath'Lists/Files.ALPHA','R')
IF x=0 THEN CALL GETOUT(24)
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
alphalist.i=line
IF alphaflag='D' THEN
DO
num=WORD(line,3)
filelist.num.0=i
END
END
CALL CLOSE(f)
alphalist.0=i-1
numba=alphalist.0
x=OPEN(a,alphaname,'W')
IF x=0 THEN CALL GETOUT(25)
title='=' bbsname
IF alphaflag='A' THEN title=title 'alphabetical'
ELSE title=title 'newest to oldest'
title=title', single-line file descriptions'
CALL WRITELN(a,title)
CALL WRITELN(a,'= Custom archived for' name' 'DATE() TIME('C'))
IF libflag='A' THEN
DO
CALL WRITELN(a,'')
CALL WRITELN(a,'Filename Bytes File# Library KeyWords')
CALL WRITELN(a,LEFT('=',77,'='))
END
CALL CLOSE(a)
x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
IF x=0 THEN CALL GETOUT(28)
CALL WRITELN(f,' Mail: 'lastm' FILE: BBBBS_'lastm)
CALL WRITELN(f,' From: BBBBS')
CALL WRITELN(f,' To: 'name)
CALL WRITELN(f,' Subj: AlphaList')
CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
CALL WRITELN(f,LEFT('=',75,'='))
CALL WRITELN(f,'Here are the single line file descriptions you requested.')
CALL WRITELN(f,'The collection process was interrupted.')
CALL CLOSE(f)
IF alphaflag='A' THEN
DO
IF libflag='L' THEN
DO i=1 TO WORDS(numlist)
CALL write_alist(WORD(numlist,i))
END
ELSE CALL write_alist(numlist)
END
ELSE
DO
IF libflag='L' THEN
DO i=1 TO WORDS(numlist)
CALL write_dlist(WORD(numlist,i))
END
ELSE CALL write_dlist(numlist)
END
IF WORD(STATEF(alphaname),2)<40 THEN CALL GETOUT(26)
CALL PRAGMA('P',0) /* normal priority */
ADDRESS COMMAND arccom alphaname||extension alphaname
IF ~EXISTS(alphaname||extension) THEN CALL GETOUT(27)
CALL PRAGMA('P',-3)
x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
IF x=0 THEN CALL GETOUT(28)
CALL WRITELN(f,' Mail: 'lastm' FILE: BBBBS_'lastm||extension)
CALL WRITELN(f,' From: BBBBS')
CALL WRITELN(f,' To: 'name)
CALL WRITELN(f,' Subj: AlphaList')
CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
CALL WRITELN(f,LEFT('=',75,'='))
CALL WRITELN(f,'Here are the single line file descriptions you requested.')
t=(.5+TIME('E'))%1
min=t%60
hrs=min%60
min=min//60
sec=t//60
temp='It took'
IF hrs>1 THEN temp=temp hrs 'hours'
ELSE IF hrs=1 THEN temp=temp '1 hour'
IF min>1 THEN temp=temp min 'minutes'
ELSE IF min=1 THEN temp=temp '1 minute'
IF sec=1 THEN temp=temp '1 second'
ELSE IF sec>0 THEN temp=temp sec 'seconds'
temp=temp 'to compile this list.'
CALL WRITELN(f,temp)
CALL CLOSE(f)
IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
DO
oldmess=GETCLIP('BBS_MESSAGE')
IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
CALL SETCLIP('BBS_MESSAGE',oldmess||'Your archived alphabetical filelist is waiting in Email.')
END
CALL GETOUT(0)
EXIT
write_alist:
ARG nlist
nlist=STRIP(nlist)
x=OPEN(a,alphaname,'A')
IF x=0 THEN RETURN
IF libflag='L' THEN
DO
CALL WRITELN(a,'')
CALL WRITELN(a,'File Library' nlist)
CALL WRITELN(a,'Filename Bytes File# Library KeyWords')
CALL WRITELN(a,LEFT('=',77,'='))
END
count=0
DO j=1 TO alphalist.0
IF j//5=0 THEN
DO
t=GETCLIP('BBS_STOP_ALPHA'clipnum)
IF t~='' THEN CALL cleanup(t)
END
IF WORD(alphalist.j,3)<=lastbrowse THEN ITERATE j
IF FIND(nlist,WORD(alphalist.j,4))=0 THEN ITERATE j
CALL WRITELN(a,alphalist.j)
count=count+1
END
CALL WRITELN(a,' 'count' files.')
CALL WRITELN(a,'')
CALL CLOSE(a)
RETURN
write_dlist:
ARG nlist
nlist=STRIP(nlist)
x=OPEN(a,alphaname,'A')
IF x=0 THEN RETURN
IF libflag='L' THEN
DO
CALL WRITELN(a,'')
CALL WRITELN(a,'File Library' nlist)
CALL WRITELN(a,'Filename Bytes File# Library KeyWords')
CALL WRITELN(a,LEFT('=',77,'='))
END
count=0
DO k=filelist.0 TO 1 BY -1
IF filelist.k='' THEN ITERATE k
IF k//5=0 THEN
DO
t=GETCLIP('BBS_STOP_ALPHA'clipnum)
IF t~='' THEN CALL cleanup(t)
END
IF k<=lastbrowse THEN LEAVE k
j=filelist.k.0
IF ~DATATYPE(j,'W') THEN ITERATE k
IF FIND(nlist,WORD(alphalist.j,4))=0 THEN ITERATE k
CALL WRITELN(a,alphalist.j)
count=count+1
END
CALL WRITELN(a,' 'count' files.')
CALL WRITELN(a,'')
CALL CLOSE(a)
RETURN
cleanup:
ARG t2 .
CALL CLOSE(a)
SAY 'User aborted!'
IF t2='DELETE' THEN ADDRESS COMMAND 'c:delete' alphaname
CALL GETOUT(0)
RETURN
ERROR:
SYNTAX:
GETOUT:
ARG errorout
CALL SETCLIP('BBS_BROWSE')
CALL SETCLIP('BBS_ALPHA'clipnum)
CALL SETCLIP('BBS_STOP_ALPHA'clipnum)
IF errorout>0 THEN SAY 'ArcAlpha error' errorout'!'
EXIT(errorout)
/* ArcAlpha.rexx */